module GlobalSearch where

import qualified Data.Set as S
import qualified Trie as M

-- Solutions are a set of maps
type Solutions a = S.Set (M.Trie a)

-- Base version of global search.

globalSearchB :: Ord a => ((String, a) -> Bool)                -- Pointwise predicate.
                       -> ((String, a) -> (String, a) -> Bool) -- Mutual predicate.
                       -> S.Set String                         -- Set of variables
                       -> S.Set a                              -- Set of values.
                       -> Solutions a                          -- Set of solutions.
globalSearchB p m var val
  | S.null var = S.singleton M.empty
  | otherwise  = let (v, var') = S.deleteFindMax var
                     s1 = globalSearchB p m var' val
                     val' = S.filter (curry p v) val
                     s2 = S.map (M.singleton v) val'
                 in S.filter (M.mutually m) (s1 `union` s2)

union :: Ord a => Solutions a -> Solutions a -> Solutions a
union s1 s2 =
  S.foldl outer S.empty s1
  where
    outer s m = S.foldl (inner m) s s2
    inner m1 s m = S.insert (M.update m1 m) s
    
    
searchA :: Ord a        => ((String, a) -> Bool)
                        -> ((String, a) -> (String, a) -> Bool) 
                        -> S.Set String
                        -> S.Set a
                        -> ((String, a) -> Bool)
                        -> S.Set (M.Trie a)
searchA p m var val c
        | S.null var = S.singleton M.empty
        | otherwise  =
                     
        S.foldl S.union S.empty (S.map f val')
        where (v, var') = S.deleteFindMax var
              val' = S.filter (curry p v) val
              f b = if c(v,b) then (searchA p m var' val (\(key, value) -> m(v,b)(key,value) && c(key,value))) `union` S.singleton (M.singleton v b)
                              else S.empty
                    

globalSearchA :: Ord a => (a -> Bool)
                           -> ((String, a) -> Bool)
                           -> ((String, a) -> (String, a) -> Bool)
                           -> S.Set String
                           -> S.Set a
                           -> S.Set (M.Trie a)
                           
globalSearchA pr p m var val = searchA p m var (S.filter pr val) (const True)

-- Laufzeittests, für n = 1000 in Sekunden
-- testPairsA 73
-- testPairsB 51

testPairsA n =  S.null (globalSearchA (\_->True) aNotTwo aSmallerB (S.insert "a" (S.singleton "b")) (S.fromAscList [1 .. n]) )

testPairsB n =  S.null (globalSearchB aNotTwo aSmallerB (S.insert "a" (S.singleton "b")) (S.fromAscList [1 .. n]) )

aNotTwo = \(k,v)-> case k of
                        "a" -> if v == 2 then False else True
                        "b" -> True
                        
aSmallerB = \(k1,v1) (k2,v2) -> case k1 of
                        "a" -> if v1 < v2 then True else False
                        "b" -> if v1 > v2 then True else False